home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / cat / storbase.i < prev    next >
Text File  |  1997-10-26  |  35KB  |  1,234 lines
  1. IMPLEMENTATION MODULE StorBase;
  2. (*$Y+,C-,R-,Z-*)
  3.  
  4. (*-----------------------------------------------------------------------------
  5.  * Copyright Januar 1987 Thomas Tempelmann, E.L.Kirchner Str.25, 29 Oldenburg
  6.  *-----------------------------------------------------------------------------
  7.  * Kurzbeschreibung : Zentrale Memoryverwaltung fr MOS
  8.  *-----------------------------------------------------------------------------
  9.  * Systemversion : MOS 1.1
  10.  * Textversion   : V#0202
  11.  *-----------------------------------------------------------------------------
  12.  * Datum    Vers  Autor  Bemerkung (Arbeitsbericht)
  13.  *-----------------------------------------------------------------------------
  14.  * 09.01.87  0.0  TT     Erste theoretisch lauff„hige Komplettversion
  15.  * 04.02.87  1.0  TT     Erste Version unter MOS, Aufruf DeAllocAll bei Term.
  16.  * 10.02.87  1.0  TT     Keine Imports mehr; @SetLevel impl.; alter Process-
  17.  *                       Term-Vektor wird nach eigener Routine angesprungen.
  18.  * 11.02.87  1.0  TT     processTerm: kein TRAP #1-Aufruf mehr
  19.  * 18.02.87  1.1  TT     MDSt-Verwaltung TOS-Kompatibel. Leider keine Freigabe
  20.  *                       der MDSts mehr, da nicht erkennbar, wann ein MDst
  21.  *                       vollkommen frei ist.
  22.  * 21.02.87  1.2  TT     MDSt wird m”glichst am Speicherende alloziert.
  23.  *                       SysLevel katalogisiert mit TOS-owner.
  24.  * 22.02.87  1.2  TT     ber 408-Vektor wird aller userMemory freigegeben,
  25.  *                       ungerade L„ngen werden dabei begradigt (Bit 31 in
  26.  *                       owner wird gel”scht).
  27.  * 25.05.87  1.3  TT     TOS-Variablen aus 'TOSPatch' importiert.
  28.  * 14.06.87  1.4  TT     Available-Funktion neu
  29.  * 22.06.87  1.5  TT     Infinite loop in allocU1 verhindert (bei 'notFnd')
  30.  * 01.07.87  1.6  TT     @SetLevel raus, stattdessen SetEnvelope-Verwendung
  31.  * 09.09.87  1.7  TT     Keep, Extend neu; Regs bei DeAllocATE, MemSize gerettet
  32.  * 25.10.87  1.8  TT     Keep jetzt KeepAll; Keep f. einzl. Blocks; MemSize
  33.  *                       liefert auch ungerade L„ngen; DeAllocAll prft auch
  34.  *                       Prozež-ID.
  35.  * 24.11.87  1.9  TT     Levels raus, jeder Level hat eigene Prozežkennung.
  36.  * 07.01.88  1.10 TT     terminate ruft DeAllocAll nun korrekt auf
  37.  * 24.01.88  1.11 TT     Bei Malloc wird oberes owner-Byte immer # 0 gesetzt
  38.  * 27.01.88  1.12 TT     testMDSt reagiert bei 32 statt 10 freien Eintr„gen
  39.  * 02.06.88  1.13 TT     Enlarge-Funktion bei 'Resize0'; allocU1 setzte owner
  40.  *                       nicht, wenn amout = ganzem Freibereich war.
  41.  * 17.06.88  1.14 TT     MD-Stack-Vars werden nicht mehr ben”tigt.
  42.  * 24.07.88  1.15 TT     MPBPtr wird generisch ermittelt.
  43.  * 27.07.88       TT     LongStack wird wieder in getMD benutzt, damit
  44.  *                       Accessories und AUTO-Prgs laufen.
  45.  * 29.07.88       TT     GetMPBPtr korrigiert (Trace-Bit wurde nicht gel”scht)
  46.  * 18.08.88  1.16 TT     LongStack-Vars werden f. TOS 1.0/1.2 hier konstant
  47.  *                       verwendet, ab TOS 1.3 werden die MD nicht mehr selbst
  48.  *                       angelegt/freigegeben, dadurch kein autom. LongStack-
  49.  *                       Erweitern mehr m”glich.
  50.  *                       D4 wird nun in ALLOCATE gerettet.
  51.  * 23.08.88       TT     Enlarge f. TOS 1.4 korrig, TrailAvail neu
  52.  * 24.08.88       TT     Register D5/D6 werden bei TrailAvail gerettet;
  53.  *                       owner wird sicherheitshalber bei Enlarge mit vollem
  54.  *                       folg. Freibereich neu gesetzt; In owner wird nicht
  55.  *                       mehr eine eigene Prozežkennung abgelegt.
  56.  * 01.10.88       TT     SysAlloc macht Speicher nun dauerhaft resident und
  57.  *                       gibt ihn nicht mehr bei Prozežende des Moduls frei.
  58.  * 23.10.88       TT     ProcessID aus MOSCtrl statt TOSPatch
  59.  * 06.11.88       TT     testMDSt erweitert Pool nicht, wenn dieser noch
  60.  *                       nicht benutzt wurde (wenn Liste leer) oder Stack
  61.  *                       nocht grož genug ist.
  62.  * 11.02.89       TT     Modul in StorBase umbenannt
  63.  * 05.07.89       TT     Wenn MPBPtr nicht gefunden wird, sind die Funktionen
  64.  *                       ALLOCATE, DEALLOCATE, SysAlloc (wie ALLOCATE),
  65.  *                       MemAvail, Available, AllAvail (wie MemAvail)
  66.  *                       weiterhin normal benutzbar. TrailAvail liefert immer
  67.  *                       Null.
  68.  *                       Die Funktionen MemSize, Keep, KeepAll, Enlarge und
  69.  *                       DEALLOCATE mit size # 0L (korrekte Gr”že geht nicht!)
  70.  *                       l”sen bei Aufruf einen Laufzeitfehler (-14,
  71.  *                       IllegalCall) aus.
  72.  *                       Es ist die Aufgabe des neuen Storage-Moduls, diese
  73.  *                       Konventionen einzuhalten!
  74.  * 16.07.90       TT     Enlarge macht keinen Fehler mehr mit ungeraden Werten
  75.  * 29.08.90       TT     DEALLOCATE meldet keinen Fehler mehr, wenn L„nge # 0
  76.  *                       und kein MPB-Zugriff; Resize neu
  77.  * 09.10.90       TT     AllAvail bercksichtigt TT-RAM
  78.  * 28.03.91       TT     AllAvail belegt alle Bereiche > 1024, um auch ohne MPB-
  79.  *                       Zugriff sinnvolle Ergebnisse zu liefern.
  80.  * 25.04.91       TT     Neues Verfahren bei GetMPB, l„uft nun mit Mega STE
  81.  *                       und wahrscheinlich auch mit PAMs Net.
  82.  * 03.05.91       TT     AllAvail bergibt Wert nicht mehr in D1, so daž GEMDOS
  83.  *                       D1 ruhig zerst”ren kann.
  84.  * 18.06.91       TT     Enlarge liefert korrekten Ergebniswert.
  85.  * 15.09.91       TT     GetMPBPtr findet offenbar auch auf dem TT den Ptr,
  86.  *                       was aber keinen Sinn macht, da nicht alle Listen
  87.  *                       oder so bercksichtigt werden. Damit da kein Scheiž
  88.  *                       passiert, wird bei TOS 3.x nie nach dem MPB gesucht.
  89.  *----------------------------------------------------------------------------*)
  90.  
  91. (*
  92.  *
  93.  * --> In der Free-List sind alle MD.start aufsteigend geordnet.
  94.  *
  95.  * D6: MPBPtr; D7: =0 -> allocMDSt aktiv.
  96.  *
  97.  * In owner steht im oberen Byte nur noch die Kennung f. ungerade L„ngen.
  98.  * Wenn ein Programm mit Ptermres endet, passiert es, daž die Speicherblocks,
  99.  * die zu der Zeit eine ungerade L„nge haben, nicht dem Prozež zugeh”rig
  100.  * erkannt werden und deshalb nicht resident gemacht werden. Zwar werden beim
  101.  * Prozežende durch 'DeAllocAll' alle owner bereinigt, aber leider wird der
  102.  * Term-Vektor bei Ptermres erst nach Residentmachen des Speichers angesprungen,
  103.  * sodaž 'DeAllocAll' zu sp„t zum Zuge kommt.
  104.  * Mit diesem kleinen Fehler sollte sich leben lassen, vor Allem, da beim
  105.  * Residentmachen durch 'InstallModule' dieses Problem nicht auftritt.
  106.  *)
  107.  
  108.  
  109. FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, LongWord, ADR, BYTE, WORD;
  110.  
  111. FROM MOSCtrl IMPORT ProcessID;
  112.  
  113. FROM MOSSupport IMPORT CallSuper;
  114.  
  115. FROM MOSGlobals IMPORT IllegalCall, MemArea, Date;
  116.  
  117. FROM MOSConfig IMPORT ExtendedMemoryAccess;
  118.  
  119. FROM PrgCtrl IMPORT EnvlpCarrier, TermCarrier, CatchProcessTerm, SetEnvelope;
  120.  
  121.  
  122. VAR     MDRoot    : ADDRESS;
  123.         LongStack : ADDRESS;
  124.         LStackPtr : ADDRESS;
  125.         LStackFree: ADDRESS;
  126.  
  127.         hasMxalloc: BOOLEAN;
  128.  
  129. CONST
  130.  
  131.   minMDs = 32; (* Soviel MDs mssen noch frei sein (s. testMDSt) *)
  132.  
  133.   ElemSize = $480; (* (64 * mdSize2) Um soviel wird der OS-Pool erweitert *)
  134.  
  135.  
  136. TYPE P_MD = POINTER TO MD;
  137.      
  138.      MD = RECORD
  139.             next: P_MD;
  140.             start: Address;
  141.             length: Longcard;
  142.             owner: Longword    (* Bit 31: length ungerade *)
  143.           END;
  144.      
  145.      P_MD2 = POINTER TO MD2;
  146.      
  147.      MD2 = RECORD
  148.              mylen: Integer;  (* Immer = 1 *)
  149.              next: P_MD;
  150.              start: Address;
  151.              length: Longcard;
  152.              owner: Longword
  153.           END;
  154.      
  155. CONST mdSize0 = 16;
  156.       mdSize2 = 18;   (* Plus vorstehendes L„ngen-word (=1) *)
  157.  
  158.       mx_alloc= $44;
  159.       m_alloc = $48;
  160.       m_free  = $49;
  161.       m_shrink= $4A;
  162.       end_os  = $4FA;
  163.  
  164.  
  165. TYPE P_MPB = POINTER TO MPB;
  166.      
  167.      MPB = RECORD
  168.              free: P_MD;
  169.              used: P_MD;
  170.              boomer: P_MD
  171.            END;
  172.      
  173.  
  174. VAR MPBPtr: P_MPB;
  175.  
  176. VAR oldStorage: BYTE;
  177.  
  178.  
  179.  
  180. (*$L-*)
  181. PROCEDURE IllCall;
  182.   BEGIN
  183.     ASSEMBLER
  184.         TRAP    #6
  185.         DC.W    IllegalCall-$C000       ; caller caused, Text folgt
  186.         ACZ     'StorBase: no MPB!'
  187.         SYNC
  188.     END
  189.   END IllCall;
  190.  
  191.  
  192. (*$L-*)
  193. PROCEDURE initMDSt;
  194. BEGIN
  195. ASSEMBLER
  196. ; D0: pMD
  197.         MOVE.L  D0,A0
  198.         MOVE.L  MD.length(A0),D5
  199.         MOVE.L  MD.start(A0),A1
  200.         
  201.         ADDQ.L  #2,A1
  202.         MOVEQ   #mdSize2,D2
  203.         
  204.         ; Ende der MD-Freiliste suchen
  205.         MOVE.L  MDRoot,A0
  206. l0      TST.L   (A0)
  207.         BEQ     st0
  208.         MOVE.L  (A0),A0
  209.         BRA     l0
  210.         
  211. nxt     MOVE    #1,-2(A1)       ; MD.mylen
  212.         MOVE.L  A1,(A0)         ; Adr. des MD dem Vorg„nger in MD.next zuweisen
  213.         MOVE.L  A1,A0
  214.         ADDA.L  D2,A1
  215. st0     SUB.L   D2,D5
  216.         BCC     nxt
  217.         
  218.         ; letztes Element mit NIL markieren
  219.         CLR.L   (A0)            ; MD.next
  220. END;
  221. END initMDSt;
  222.  
  223.  
  224. FORWARD allocU1;
  225.  
  226. (*$L-*)
  227. PROCEDURE testMDSt;
  228.   CONST lstsize = 32 * 9;
  229.   BEGIN
  230.     ASSEMBLER
  231.         
  232.         TST     D7
  233.         BEQ     ende            ; Rekursionen m”gen wir nicht
  234.  
  235.         MOVE.L  MDRoot,A0
  236.         MOVE.L  (A0),D0
  237.         BEQ     ende            ; Keine Erweiterung, wenn noch kein Pool exist.
  238.  
  239.         MOVE.L  LStackFree,A0
  240.         MOVE.W  (A0),D1
  241.         DIVU    #9,D1           ; D1: Anz. freier MD-Pl„tze
  242.         SUBI    #minMDs,D1      ; mind. ben”tigte freie Anzahl
  243.         BCC     ende            ; noch genug frei
  244.         NEG     D1              ; -> fehlende Anzahl in Liste prfen
  245.         SUBA.L  A0,A0
  246. loop0   MOVE.L  0(A0,D0.L),D0
  247.         DBEQ    D1,loop0
  248.         BNE     ende
  249. gotit
  250.         ; Neuen MDSt anlegen
  251.         
  252.         ; Size v. elems*16 als amount
  253.         MOVE.L  #ElemSize,D5
  254.         MOVEQ   #0,D3
  255.         CLR     D7
  256.         MOVEQ   #0,D4           ; owner = 0L
  257.         JSR     allocU1         ; D6 (MPBPtr) stimmt wohl noch
  258.         MOVEQ   #1,D7
  259.         
  260.         TST.L   D0
  261.         BEQ     ende
  262.         
  263.         JSR     initMDSt
  264. ende
  265. END;
  266. END testMDSt;
  267.  
  268.  
  269. (*$L-*)
  270. PROCEDURE getMD;  (* Ergebnis in D0 *)
  271. BEGIN
  272. ASSEMBLER
  273.         ; D3 erhalten !
  274.         ; D4: owner
  275.         
  276.         MOVE.L  MDRoot,A0
  277.         TST.L   (A0)
  278.         BEQ     instack
  279.         
  280.         MOVE.L  (A0),A1
  281.         MOVE.L  (A1),(A0)
  282.         MOVE.L  A1,D0
  283.         BRA     ende
  284.         
  285. instack MOVEQ   #0,D0
  286.         MOVE.L  LStackFree,A0
  287.         CMPI.W  #9,(A0)        ; noch Platz im Stack ?
  288.         BLS     ende
  289.         SUBI.W  #9,(A0)        ; freie Elemente in Stack
  290.         MOVE.L  LStackPtr,A0
  291.         MOVE.W  (A0),D0        ; Stackpointer
  292.         ASL.W   #1,D0          ; *2
  293.         EXT.L   D0
  294.         MOVE.L  D0,A1
  295.         ADDA.L  LongStack,A1
  296.         ADDI.W  #9,(A0)        ; Stackpointer erh”hen
  297.         MOVE.W  #1,(A1)        ; die L„nge des Elements im Element ablegen
  298.         ADDQ.L  #2,A1
  299.         MOVE.L  A1,D0
  300.         
  301. ende    MOVE.L  D4,MD.owner(A1)
  302. END
  303. END getMD;
  304.  
  305.  
  306.  
  307. (*$L-*)
  308. PROCEDURE findMD; (* D6: MPBPtr, D5: start *)
  309. BEGIN
  310. ASSEMBLER
  311.         MOVE.L  D6,A0
  312.         MOVE.L  MPB.used(A0),A0
  313.       s CMP.L   MD.start(A0),D5
  314.         BEQ     f
  315.         MOVE.L  (A0),A0
  316.         MOVE.L  A0,D0
  317.         BNE     s
  318.       f MOVE.L  A0,D0
  319. END
  320. END findMD;
  321.  
  322.  
  323. (*$L-*)
  324. PROCEDURE resize2; (* D6: MPBPtr, D5: start, D3: ADR(p), D4: len *)
  325. BEGIN
  326. ASSEMBLER
  327.         TST.L   D4
  328.         BEQ     all
  329.         
  330.         JSR     findMD
  331.         BEQ.W   endeClrF
  332.  
  333.         MOVE.L  MD.length(A0),D1
  334.         MOVE.B  MD.owner(A0),D0
  335.         BPL     even
  336.         SUBQ.L  #1,D1
  337. even    SUB.L   D4,D1           ; neuer User-amount
  338.         BLE.W   all
  339.  
  340.         ADDQ.L  #1,D1
  341.         ORI     #$80,D0
  342. even2   CMP.L   MD.length(A0),D1        ; Bleibt bisherige L„nge gleich ?
  343.         BEQ     endeSet                 ; dann bleibt's beim Alten
  344.  
  345.         TST.L   D4
  346.         BMI     enlarg
  347.  
  348.         ; Mshrink ausfhren
  349.         MOVE.B  D0,MD.owner(A0)
  350.         MOVE.L  D1,-(A7)        ; neue L„nge
  351.         MOVE.L  D5,-(A7)        ; start
  352.         CLR     -(A7)
  353.         MOVE    #m_shrink,-(A7)
  354.         TRAP    #1              ; Mshrink (p)
  355.         ADDA.W  #12,A7
  356.         BRA.W   endeT
  357.  
  358. all     MOVE.L  D5,-(A7)
  359.         MOVE    #m_free,-(A7)
  360.         TRAP    #1              ; Mfree (p)
  361.         ADDQ.L  #6,A7
  362.         MOVE.L  D3,A0
  363.         CLR.L   (A0)
  364.         TST.L   D0
  365.         BEQ.W   endeT
  366.         BRA.W   endeF
  367.  
  368. enlarg  ; anschlieženden Free-MD ermitteln
  369.         MOVE.L  D1,D4                   ; neue gerundete L„nge
  370.         SUB.L   MD.length(A0),D4        ; D4: neue gerundete L„ngendiff. (pos.)
  371.         MOVE    D0,-(A7)
  372.         MOVE.L  MD.start(A0),D2
  373.         ADD.L   MD.length(A0),D2        ; hier muž ein Freibereich stehen
  374.         MOVE.L  D6,A2
  375.         MOVE.L  MPB.free(A2),A2
  376.         BRA     cont2
  377. srch2   CMP.L   MD.start(A2),D2 ; start aus Free-List
  378.         BEQ     fnd2            ; gefunden
  379.         MOVE.L  (A2),A2         ; MD.next
  380. cont2   MOVE.L  A2,D0
  381.         BNE     srch2
  382.         MOVE    (A7)+,D0
  383.         BRA     endeF           ; dahinter nix mehr frei
  384. fnd2    MOVE    (A7)+,D0
  385.         MOVE.L  MD.length(A2),D2 ; free-L„nge
  386.         ADD.L   MD.length(A0),D2 ; plus used-L„nge ergibt gesamte verfgb. L„nge
  387.         SUB.L   D1,D2           ; minus neue ben”tigte L„nge ist Rest-Freil„nge
  388.         BCS     endeF           ; reicht nicht aus
  389.         BEQ     replace         ; da wird's schwierig...
  390.         MOVE.L  D2,MD.length(A2) ; free-L„nge korrigieren
  391.         ADD.L   D4,MD.start(A2)  ; free-Start korrigieren
  392.         MOVE.L  D1,MD.length(A0) ; used-L„nge korrigieren
  393.  
  394. endeSet MOVE.B  D0,MD.owner(A0)
  395.         BRA     endeT
  396.  
  397. replace ; der Frei-Bereich muž entfernt werden.
  398.         ; dazu wird der Used-Bereich freigegeben und dann wieder in einen
  399.         ; used-Bereich zurckverwandelt
  400.         MOVE.L  D5,-(A7)
  401.         MOVE    #m_free,-(A7)
  402.         TRAP    #1              ; Mfree (p)
  403.         ADDQ.L  #6,A7
  404.  
  405.         ; MD in Freibereich wiederfinden
  406.         MOVE.L  D6,A0
  407.       s MOVE.L  A0,A1           ; Vorg„nger retten
  408.         MOVE.L  (A0),A0
  409.         CMP.L   MD.start(A0),D5
  410.         BNE     s
  411.         ; MD aush„ngen und in Used-List einh„ngen
  412.         MOVE.L  (A0),(A1)
  413.         MOVE.L  D6,A2
  414.         MOVE.L  A1,MPB.boomer(A2)
  415. bok     MOVE.L  MPB.used(A2),MD.next(A0)
  416.         MOVE.L  A0,MPB.used(A2)
  417.  
  418. endeT   MOVEQ   #1,D0
  419.         RTS
  420.  
  421. endeClrF
  422.         MOVE.L  D3,A0
  423.         CLR.L   (A0)
  424. endeF   MOVEQ   #0,D0
  425. END
  426. END resize2;
  427.  
  428.  
  429. (*$L+*)
  430. PROCEDURE Resize0 ( VAR p: Address; len: Longint ): Boolean;
  431. VAR res:Boolean;
  432. BEGIN
  433. ASSEMBLER
  434.         MOVEM.L D3-D7,-(A7)
  435.         CLR     D0
  436.         MOVE.L  p(A6),A0
  437.         MOVE.L  A0,D3
  438.         MOVE.L  (A0),D5
  439.         BEQ     ende            ; 'p' ist NIL
  440.         MOVE.L  MPBPtr,D6
  441.         MOVE.L  len(A6),D4
  442.  
  443. newsto  ; Ver„ndern der Gr”že
  444.         JSR     Resize2
  445.         (*
  446.         PEA     Resize2
  447.         JSR     CallSuper
  448.         ADDQ.L  #4,A7
  449.         *)
  450.  
  451. ende    MOVEM.L (A7)+,D3-D7
  452.         MOVE    D0,res(A6)
  453. END;
  454. RETURN res
  455. END Resize0;
  456.  
  457. (*$L-*)
  458. PROCEDURE freeAll;
  459. BEGIN
  460. ASSEMBLER
  461.         MOVE.L  (A3),D2
  462.         MOVE.L  MPBPtr,A2
  463.         ADDQ.L  #MPB.used,A2    ; LEA MPB.used(A2),A2
  464.         BRA     cont0
  465. srch0   MOVE.L  MD.owner(A2),D1
  466.         ANDI.L  #$00FFFFFF,D1   ; oberes Byte ausblenden wg. Ungerade-Kennung
  467.         CMP.L   D1,D2
  468.         BNE     cont0
  469.         CLR.B   MD.owner(A2)
  470. cont0   MOVE.L  (A2),A2         ; MD.next
  471.         MOVE.L  A2,D1
  472.         BNE     srch0
  473. END;
  474. END freeAll;
  475.  
  476.  
  477. (*$L-*)
  478. PROCEDURE DeAllocAll ( owner: LONGWORD );
  479. BEGIN
  480. ASSEMBLER
  481.         SUBQ.L  #4,A3
  482.         MOVE.L  MPBPtr,D0
  483.         BEQ     ende            ; Wenn kein MPBPtr, ist dies unn”tig
  484.         JSR     freeAll
  485.         (*
  486.         MOVE.L  #freeAll,-(A7)
  487.         JSR     CallSuper
  488.         ADDQ.L  #4,A7
  489.         *)
  490. ende
  491. END
  492. END DeAllocAll;
  493.  
  494.  
  495. (*$L-*)
  496. PROCEDURE allocU1; (* D6:MPBPtr, D5:amount, D4:owner *)
  497. BEGIN
  498. ASSEMBLER
  499.         ; A1: zeigt auf aktuellen Free-MD
  500.         ; A2: zeigt auf Vorg„nger
  501.         
  502.         MOVE.L  D4,-(A7)
  503.         
  504.         ; Neuen MDSt anlegen ?
  505.         MOVEM.L D3/D5,-(A7)
  506.         JSR     testMDSt
  507.         MOVEM.L (A7)+,D3/D5
  508.         
  509.         MOVE.L  D6,A0
  510.         MOVE.L  MPB.boomer(A0),A2
  511.         MOVE.L  A2,D0
  512.         BEQ.L   ende                    ; keine Freiliste !?
  513.         
  514.         MOVE.L  (A2),A1                 ; ^ Root Freiliste
  515.         CLR.L   D4                      ; h”chste Adr.
  516.         
  517. srch1   MOVE.L  A1,D0                   ; Ende der Freiliste ?
  518.         BNE     srch2
  519.         MOVE.L  D6,A2                   ; Ja
  520.         MOVE.L  (A2),A1                 ; MPB.free
  521.         
  522. srch2   MOVE.L  MD.length(A1),D0
  523.         CMP.L   D5,D0
  524.         BEQ     isEqu
  525.         BHI     isHi            ; Der Bereich ist gr”žer
  526.         BRA.L   notFnd          ; Der Freibereich ist zu klein
  527.  
  528. extrem  ; m”glichst hohe Adr. suchen
  529.         CMP.L   MD.start(A1),D4
  530.         BCC.L   notFnd
  531.         MOVE.L  MD.start(A1),D4
  532.         MOVE.L  A1,A3
  533.         MOVE.L  A3,A4
  534.         BRA.W   notFnd
  535.  
  536. isEqu   ; Der freie Bereich pažt genau.
  537.         TST     D7
  538.         BEQ     extrem
  539. isEqu0  MOVE.L  (A1),(A2)       ; MD aus Free-Liste auslinken
  540.         MOVE.L  (A7),MD.owner(A1)
  541.         BRA     found
  542.         
  543. isHi    TST     D7
  544.         BEQ     extrem
  545.         ; Eintrag des neuen Used-MD, A0: ^ auf neuen Used-MD
  546. isHi0   MOVE.L  (A7),D4
  547.         MOVEM.L D5/A1/A2,-(A7)
  548.         JSR     getMD           ; Legt MD an, liefert Adr. in D0
  549.         MOVEM.L (A7)+,D5/A1/A2
  550.         TST.L   D0
  551.         BEQ.L   ende
  552.         MOVE.L  D0,A0
  553.         
  554.         TST     D7                      ; oberen Bereich abknapsen ?
  555.         BNE     takeLow
  556.         
  557.         MOVE.L  MD.start(A1),D0         ; Used-start auf alten Freibereich
  558.         ADD.L   MD.length(A1),D0        ; Used-start auf Ende des Bereichs
  559.         SUB.L   D5,D0                   ; Minus Bereichsl„nge
  560.         MOVE.L  D0,MD.start(A0)         ; Als Used-Start
  561.         SUB.L   D5,MD.length(A1)        ; Frei-L„nge um belegten Bereich verkl.
  562.         BNE     qw1
  563.         BREAK
  564.       qw1:
  565.         MOVE.L  D5,MD.length(A0)        ; Used-Length setzen.
  566.         BNE     qw2
  567.         BREAK
  568.       qw2:
  569.         MOVE.L  A0,A1                   ; A1:=Adr (Used-MD)
  570.         BRA     found
  571.         
  572. takeLow MOVE.L  MD.start(A1),MD.start(A0) ; Used-start auf alten Freibereich
  573.         ADD.L   D5,MD.start(A1)         ; Frei-Beginn um bel. Bereich erh”hen
  574.         SUB.L   D5,MD.length(A1)        ; Frei-L„nge um belegten Bereich verkl.
  575.         BNE     qw3
  576.         BREAK
  577.       qw3:
  578.         MOVE.L  D5,MD.length(A0)        ; Used-Length setzen.
  579.         BNE     qw4
  580.         BREAK
  581.       qw4:
  582.         MOVE.L  D0,A1                   ; A1:=Adr (Used-MD)
  583.         
  584. found   MOVE.L  D6,A0
  585.         MOVE.L  MPB.used(A0),(A1)       ; MD in Used-Liste einlinken
  586.         MOVE.L  A1,MPB.used(A0)         ; Neuen Used-MD als Used-Listenbeginn
  587.         
  588.         ; Den boomer-^ korrigieren
  589.         MOVE.L  D6,A0
  590.         MOVE.L  A2,MPB.boomer(A0)
  591.         
  592.         MOVE.B  D3,MD.owner(A1)
  593.         
  594.         MOVE.L  A1,D0           ; Ergebnis
  595.         BRA     ende            ; jetzt ham wir's
  596.         
  597. notFnd  MOVE.L  A1,A2
  598.         MOVE.L  (A1),A1                 ; MD.next
  599.         
  600.         MOVE.L  D6,A0
  601.         MOVE.L  MPB.boomer(A0),D0
  602.         CMP.L   D0,D6
  603.         BEQ     notFC2                  ; boomer zeigt auf eigenen MD / MPB
  604.         
  605.         CMP.L   A2,D0
  606.         BNE     srch1
  607.         BRA     srchEnd
  608.         
  609. notFC2  MOVE.L  A1,D0                   ; Ende der Freiliste ?
  610.         BNE     rovnen2
  611.         MOVE.L  D6,A2                   ; Ja
  612.         MOVE.L  (A2),A1                 ; MPB.free
  613. rovnen2 MOVE.L  D6,A0
  614.         CMPA.L  MPB.boomer(A0),A2
  615.         BNE     srch2
  616.         
  617. srchEnd TST     D7
  618.         BNE     ende0
  619.         TST.L   D4
  620.         BEQ     ende0           ; kein Platz gef.
  621.         MOVE.L  A3,A1
  622.         MOVE.L  A4,A2
  623.         MOVE.L  MD.length(A1),D0
  624.         CMP.L   D5,D0
  625.         BEQ     isEqu0
  626.         BHI     isHi0           ; Der Bereich ist gr”žer
  627.         
  628. ende0   CLR.L   D0              ; keinen Platz gefunden
  629. ende    ADDQ.L  #4,A7
  630. END
  631. END allocU1;
  632.  
  633.  
  634. (*$L-*)
  635. PROCEDURE allocU2; (* D6:MPBPtr, D5: start, D4:owner *)
  636. BEGIN
  637. ASSEMBLER
  638. END
  639. END allocU2;
  640.  
  641. (*$L-*)
  642. PROCEDURE Malloc ( amount: Longcard; prID: LONGWORD ): Address;
  643. BEGIN
  644. ASSEMBLER
  645.         MOVEM.L D3-D7,-(A7)
  646.         
  647.         MOVE.L  -(A3),D4
  648.         MOVE.L  -(A3),D5
  649.         BLE     endeClr
  650.         ADDQ.L  #1,D5
  651.         BCLR    #0,D5           ; Sync; keine ungeraden Adr.
  652.         SEQ     D3              ; D3 wird $FF, wenn amount ungerade war.
  653.         AND     #$80,D3
  654.         MOVE.L  MPBPtr,D6
  655.         BRA     newsto 
  656.  
  657. endeClr CLR.L   D0
  658. ende    MOVE.L  D0,(A3)+
  659.         BRA     ende0
  660.  
  661. newsto  ; Malloc ohne LongStack-Zugriffe
  662.         ; Dazu erst den Speicher ber GEMDOS anfordern und dann
  663.         ; den Owner und evtl. Markierung f. ungeraden Amount setzen
  664.         MOVE.L  D5,-(A7)
  665.         MOVE    #m_alloc,-(A7)
  666.         TRAP    #1              ; Malloc (D5)
  667.         ADDQ.L  #6,A7
  668.         TST.L   D0
  669.         BNE.S   weiter
  670.                                 ; NIL zurckbekommen, mal mit Mxalloc versuchen
  671.         TST.W   hasMxalloc      ; Mxalloc vorhanden?
  672.         BEQ.S   weiter          ; nein, nicht da
  673.         
  674.         MOVE.W  #3,-(A7)        ; Mxalloc mit Fast-RAM preffered
  675.         MOVE.L  D5,-(A7)
  676.         MOVE.W  #mx_alloc,-(A7)
  677.         TRAP    #1              ; Mxalloc (3, D5)
  678.         ADDQ.L  #8,A7
  679.         
  680. weiter:
  681.         MOVE.L  D0,(A3)+
  682.         BEQ     ende0           ; Kein Speicher mehr -> Ende
  683.  
  684.         TST.L   D6
  685.         BEQ     ende0           ; Nicht Owner/Odd setzen, wenn MPBPtr fehlt
  686.  
  687.         MOVE.L  D0,D5
  688.         JSR     findMD
  689.         (*
  690.         PEA     findMD
  691.         JSR     CallSuper
  692.         ADDQ.L  #4,A7
  693.         *)
  694.         TST.L   D0
  695.         BEQ     ende0
  696.         MOVE.L  D4,MD.owner(A0)
  697.         MOVE.B  D3,MD.owner(A0)
  698.  
  699. ende0:  MOVEM.L (A7)+,D3-D7
  700. END;
  701. END Malloc;
  702.  
  703.  
  704. (*$L-*)
  705. PROCEDURE ALLOCATE ( VAR addr: ADDRESS; len: LONGCARD );
  706.   BEGIN
  707.     ASSEMBLER
  708.         MOVE.L  ProcessID,A0
  709.         MOVE.L  (A0),(A3)+
  710.         JSR     Malloc
  711.         MOVE.L  -(A3),D0
  712.         MOVEA.L -(A3),A0
  713.         MOVE.L  D0,(A0)
  714.     END
  715.   END ALLOCATE;
  716.  
  717. (*$L-*)
  718. PROCEDURE SysAlloc ( VAR addr: ADDRESS; len: LONGCARD );
  719.   BEGIN
  720.     ASSEMBLER
  721.         CLR.L   (A3)+
  722.         JSR     Malloc
  723.         MOVE.L  -(A3),D0
  724.         MOVEA.L -(A3),A0
  725.         MOVE.L  D0,(A0)
  726.     END
  727.   END SysAlloc;
  728.  
  729.  
  730. (*$L-*)
  731. PROCEDURE DEALLOCATE ( VAR addr: ADDRESS; len: LONGCARD );
  732.   BEGIN
  733.     ASSEMBLER
  734.         TST.L   MPBPtr
  735.         BNE     ok
  736.         CLR.L   -4(A3)          ; alles freigeben
  737.      ok JSR     Resize0
  738.         SUBQ.L  #2,A3
  739.     END
  740.   END DEALLOCATE;
  741.  
  742.  
  743. (*$L-*)
  744. PROCEDURE Enlarge ( VAR addr: ADDRESS; len: LONGCARD; VAR ok: BOOLEAN );
  745.   BEGIN
  746.     ASSEMBLER
  747.         MOVE.L  -(A3),-(A7)
  748.         NEG.L   -4(A3)
  749.         BPL     err
  750.         TST.L   MPBPtr
  751.         BEQ     err
  752.         JSR     Resize0
  753.         MOVE.L  (A7)+,A0
  754.         MOVE.W  -(A3),(A0)
  755.         RTS
  756.       err
  757.         SUBQ.L  #8,A3
  758.         MOVE.L  (A7)+,A0
  759.         CLR.W   (A0)
  760.     END
  761.   END Enlarge;
  762.  
  763.  
  764. (*$L-*)
  765. PROCEDURE trailAv1; (* D6: MPBPtr, D5: start *)
  766. BEGIN
  767. ASSEMBLER
  768.         ; used-MD finden
  769.         JSR     findMD
  770.         BEQ.S   endeClr
  771.  
  772.         ; anschlieženden Free-MD ermitteln
  773.         MOVE.L  MD.start(A0),D2
  774.         ADD.L   MD.length(A0),D2        ; hier muž ein Freibereich stehen
  775.         MOVE.L  D6,A2
  776.         MOVE.L  MPB.free(A2),A2
  777.         BRA.S   cont2
  778. srch2   CMP.L   MD.start(A2),D2 ; start aus Free-List
  779.         BEQ.S   fnd2            ; gefunden
  780.         MOVE.L  (A2),A2         ; MD.next
  781. cont2   MOVE.L  A2,D0
  782.         BNE     srch2
  783.         BRA.S   endeClr         ; dahinter nix mehr frei
  784. fnd2    MOVE.L  MD.length(A2),D0 ; free-L„nge
  785.         BRA.S   ende
  786.  
  787. endeClr MOVEQ   #0,D0
  788. ende
  789. END
  790. END  trailAv1;
  791.  
  792. (*$L-*)
  793. PROCEDURE TrailAvail (ad: ADDRESS): LONGCARD;
  794.   BEGIN
  795.     ASSEMBLER
  796.         MOVEM.L D5/D6,-(A7)
  797.         MOVE.L  -(A3),D5
  798.         MOVEQ   #0,D0
  799.         MOVE.L  MPBPtr,D6
  800.         BEQ.S   null
  801.         JSR     trailAv1
  802.         (*
  803.         PEA     trailAv1
  804.         JSR     CallSuper
  805.         ADDQ.L  #4,A7
  806.         *)
  807.       null
  808.         MOVE.L  D0,(A3)+
  809.         MOVEM.L (A7)+,D5/D6
  810.     END
  811.   END TrailAvail;
  812.  
  813.  
  814. (*$L-*)
  815. PROCEDURE MemSize ( addr: ADDRESS ): LONGCARD;
  816.   BEGIN
  817.     ASSEMBLER
  818.         TST.L   MPBPtr
  819.         BEQ.s   err
  820.  
  821.         MOVE.L  D5,-(A7)
  822.         MOVE.L  -(A3),D5
  823.         BSR     l(PC)
  824.         (*
  825.         PEA     l(PC)
  826.         JSR     CallSuper
  827.         ADDQ.L  #4,A7
  828.         *)
  829.         MOVE.L  (A7)+,D5
  830.         MOVE.L  D0,(A3)+
  831.         RTS
  832.  
  833. err     SUBQ.L  #4,A3
  834.         LINK    A5,#0
  835.         JSR     IllCall
  836.         UNLK    A5
  837.         CLR.L   (A3)+
  838.         RTS
  839.  
  840.       l ; MOVE    SR,-(A7)
  841.         ; ORI     #$700,SR
  842.         MOVE.L  D6,-(A7)        ; D6 retten
  843.         MOVE.L  MPBPtr,D6
  844.         JSR     findMD
  845.         BEQ.S   e
  846.         MOVE.L  MD.length(A0),D0
  847.         TST.B   MD.owner(A0)
  848.         BPL.S   e
  849.         SUBQ.L  #1,D0
  850.       e MOVE.L  (A7)+,D6
  851.         ; MOVE    (A7)+,SR
  852.     END
  853.   END MemSize;
  854.  
  855. (*$L-*)
  856. PROCEDURE avail;
  857.   BEGIN
  858.     ASSEMBLER
  859.         TST.L   MPBPtr
  860.         BEQ     norm
  861.         BSR     l(PC)
  862.         (*
  863.         PEA     l(PC)
  864.         JSR     CallSuper
  865.         ADDQ.L  #4,A7
  866.         *)
  867.         RTS
  868.  
  869. norm    ; IN: D2: 1 -> AllAvail bestimmen
  870.         TST.W   D2
  871.         BNE     all
  872.         
  873.         MOVEQ   #-1,D0
  874.         MOVE.L  D0,-(A7)
  875.         MOVE    #$48,-(A7)      ; malloc (-1L)
  876.         TRAP    #1
  877.         ADDQ.L  #6,A7
  878.         RTS
  879.         
  880. all     MOVE.L  D3,-(A7)
  881.         MOVEQ   #0,D3           ; z„hlt Gesamtmenge
  882.         CLR.L   -(A7)           ; Endmarke fr gestackte Alloc-Adressen
  883. luup    MOVEQ   #-1,D0
  884.         MOVE.L  D0,-(A7)
  885.         MOVE    #$48,-(A7)      ; malloc (-1L)
  886.         TRAP    #1
  887.         ADDQ.L  #6,A7
  888.         ADD.L   D0,D3
  889.         CMPI.L  #1024,D0        ; Bereiche < 1024 nicht bercksichtigen
  890.         BCS     ende
  891.         MOVE.L  D0,-(A7)
  892.         MOVE    #$48,-(A7)      ; malloc ()
  893.         TRAP    #1
  894.         ADDQ.L  #6,A7
  895.         MOVE.L  D0,-(A7)        ; Adr des Bereichs merken
  896.         BRA     luup
  897. ende    TST.L   (A7)
  898.         BEQ     ende2
  899.         MOVE    #m_free,-(A7)
  900.         TRAP    #1
  901.         ADDQ.L  #6,A7
  902.         BRA     ende
  903. ende2   ADDQ.L  #4,A7
  904.         MOVE.L  D3,D0
  905.         MOVE.L  (A7)+,D3
  906.         RTS
  907.  
  908.         (*
  909.         MOVEQ   #-1,D0
  910.         MOVE.L  D0,-(A7)
  911.         MOVE    #$48,-(A7)      ; malloc (-1L)
  912.         TRAP    #1
  913.         ADDQ.L  #6,A7
  914.         MOVE.L  D0,D1
  915.         TST     gemdos1900
  916.         BEQ     noMX
  917.         MOVE.L  D0,-(A7)
  918.         MOVE.W  #1,-(A7)
  919.         MOVE.L  #-1,-(A7)
  920.         MOVE    #$44,-(A7)      ; mxalloc (-1L, 1)
  921.         TRAP    #1
  922.         ADDQ.L  #8,A7
  923.         MOVE.L  D0,D1
  924.         MOVE.L  (A7)+,D0
  925.         ADD.L   D1,D0
  926.         RTS
  927.         *)
  928.  
  929.       l ; MOVE    SR,-(A7)
  930.         ; ORI     #$700,SR
  931.         CLR.L   D0
  932.         CLR.L   D1
  933.         MOVE.L  MPBPtr,A0
  934.         MOVE.L  (A0),A0
  935.       s ADD.L   MD.length(A0),D1
  936.         CMP.L   MD.length(A0),D0
  937.         BCC     c
  938.         MOVE.L  MD.length(A0),D0
  939.       c MOVE.L  (A0),A0
  940.         MOVE.L  A0,D2
  941.         BNE     s
  942.         TST.W   D2
  943.         BEQ     single
  944.         MOVE.L  D1,D0
  945.       single
  946.         ; MOVE    (A7)+,SR
  947.     END
  948.   END avail;
  949.  
  950. (*$L-*)
  951. PROCEDURE MemAvail (): LONGCARD;
  952.   BEGIN
  953.     ASSEMBLER
  954.         MOVEQ   #0,D2
  955.         JSR     avail
  956.         MOVE.L  D0,(A3)+
  957.     END
  958.   END MemAvail;
  959.  
  960. (*$L-*)
  961. PROCEDURE AllAvail (): LONGCARD;
  962.   BEGIN
  963.     ASSEMBLER
  964.         MOVEQ   #1,D2
  965.         JSR     avail
  966.         MOVE.L  D0,(A3)+
  967.     END
  968.   END AllAvail;
  969.  
  970. (*$L-*)
  971. PROCEDURE Available (l:LONGCARD):BOOLEAN;
  972.   BEGIN
  973.     ASSEMBLER
  974.         MOVEQ   #0,D2
  975.         JSR     avail
  976.         CMP.L   -(A3),D0
  977.         SCC     D0
  978.         ANDI    #1,D0
  979.         MOVE    D0,(A3)+
  980.     END
  981.   END Available;
  982.  
  983. (*$L-*)
  984. PROCEDURE Keep ( addr: ADDRESS );
  985.   BEGIN
  986.     ASSEMBLER
  987.         TST.L   MPBPtr
  988.         BEQ.S   err
  989.         MOVE.L  D3,-(A7)
  990.         MOVE.L  -(A3),D3
  991.         BSR     l(PC)
  992.         (*
  993.         PEA     l(PC)
  994.         JSR     CallSuper
  995.         ADDQ.L  #4,A7
  996.         *)
  997.         MOVE.L  (A7)+,D3
  998.         RTS
  999.  
  1000. err     SUBQ.L  #4,A3
  1001.         LINK    A5,#0
  1002.         JSR     IllCall
  1003.         UNLK    A5
  1004.         RTS
  1005.  
  1006.      l: ; MOVE    SR,-(A7)
  1007.         ; ORI     #$700,SR
  1008.         MOVE.L  MPBPtr,A0
  1009.         ADDQ.L  #MPB.used,A0    ; LEA MPB.used(A0),A0
  1010.         BRA     cont0
  1011. srch0   CMP.L   MD.start(A0),D3
  1012.         BEQ     found
  1013. cont0   MOVE.L  (A0),A0         ; MD.next
  1014.         MOVE.L  A0,D0
  1015.         BNE     srch0
  1016.         BRA     ende
  1017. found   MOVE.B  MD.owner(A0),D0
  1018.         CLR.L   MD.owner(A0)    ; Prozež-ID l”schen
  1019.         MOVE.B  D0,MD.owner(A0)
  1020. ende    ; MOVE    (A7)+,SR
  1021.     END
  1022.   END Keep;
  1023.  
  1024.  
  1025. (*$L-*)
  1026. PROCEDURE KeepAll (processID:LONGWORD);
  1027.   BEGIN
  1028.     ASSEMBLER
  1029.         TST.L   MPBPtr
  1030.         BEQ.S   err
  1031.         MOVE.L  D3,-(A7)
  1032.         MOVE.L  -(A3),D3
  1033.         BSR     l(PC)
  1034.         (*
  1035.         PEA     l(PC)
  1036.         JSR     CallSuper
  1037.         ADDQ.L  #4,A7
  1038.         *)
  1039.         MOVE.L  (A7)+,D3
  1040.         RTS
  1041.  
  1042. err     SUBQ.L  #4,A3
  1043.         LINK    A5,#0
  1044.         JSR     IllCall
  1045.         UNLK    A5
  1046.         RTS
  1047.  
  1048.      l: ; alle MD mit owner=D3 resident machen
  1049.         ; MOVE    SR,-(A7)
  1050.         ; ORI     #$700,SR
  1051.         MOVE.L  MPBPtr,A0
  1052.         ADDQ.L  #MPB.used,A0    ; LEA MPB.used(A0),A0
  1053.         BRA     cont0
  1054. srch0   MOVE.L  MD.owner(A0),D0
  1055.         ANDI.L  #$00FFFFFF,D0   ; oberes Byte ausblenden
  1056.         CMP.L   D0,D3
  1057.         BNE     cont0
  1058.         MOVE.B  MD.owner(A0),D0
  1059.         CLR.L   MD.owner(A0)    ; Prozež-ID l”schen
  1060.         MOVE.B  D0,MD.owner(A0)
  1061. cont0   MOVE.L  (A0),A0         ; MD.next
  1062.         MOVE.L  A0,D0
  1063.         BNE     srch0
  1064.         ; MOVE    (A7)+,SR
  1065.     END
  1066.   END KeepAll;
  1067.  
  1068.  
  1069. (*$L-*)
  1070. PROCEDURE FullStorBaseAccess (): BOOLEAN;
  1071.   BEGIN
  1072.     ASSEMBLER
  1073.         TST.L   MPBPtr
  1074.         SNE     D0
  1075.         ANDI    #1,D0
  1076.         MOVE    D0,(A3)+
  1077.     END
  1078.   END FullStorBaseAccess;
  1079.  
  1080.  
  1081. (*$L+*)
  1082. PROCEDURE Inconsistent (): BOOLEAN;
  1083.   BEGIN
  1084.     (*!!! noch ausprogrammieren *)
  1085.     RETURN FALSE
  1086.   END Inconsistent;
  1087.  
  1088.  
  1089. (*$L-*)
  1090. PROCEDURE Resize ( VAR addr: ADDRESS; newSize: LONGCARD; VAR ok: BOOLEAN);
  1091.   BEGIN
  1092.     ASSEMBLER
  1093.         MOVE.L  -(A3),-(A7)
  1094.         TST.L   -4(A3)
  1095.         BEQ     all
  1096.         TST.L   MPBPtr
  1097.         BEQ     noFull
  1098.         MOVE.L  -8(A3),A0
  1099.         MOVE.L  (A0),(A3)+
  1100.         JSR     MemSize
  1101.         MOVE.L  -(A3),D0
  1102.         SUB.L   -(A3),D0
  1103.         MOVE.L  D0,(A3)+
  1104.       all
  1105.         JSR     Resize0
  1106.         MOVE.L  (A7)+,A0
  1107.         MOVE.W  -(A3),(A0)
  1108.         RTS
  1109.       noFull
  1110.         MOVE.L  -(A3),-(A7)     ; neue L„nge
  1111.         MOVE.L  -(A3),A0
  1112.         MOVE.L  (A0),-(A7)      ; start
  1113.         CLR     -(A7)
  1114.         MOVE    #m_shrink,-(A7)
  1115.         TRAP    #1              ; Mshrink ()
  1116.         ADDA.W  #12,A7
  1117.         MOVE.L  (A7)+,A0
  1118.         TST.L   D0
  1119.         SEQ     D0
  1120.         ANDI    #1,D0
  1121.         MOVE    D0,(A0)
  1122.     END
  1123.   END Resize;
  1124.  
  1125.  
  1126. (*$L-*)
  1127. PROCEDURE More (id:INTEGER;p:ADDRESS);
  1128.   BEGIN
  1129.     ASSEMBLER
  1130.         MOVE.L  -(A3),A0
  1131.         MOVE.W  -(A3),D0
  1132.         CMPI.W  #$4EF1,D0
  1133.         BNE     trail
  1134.         MOVE.L  (A0)+,(A3)+
  1135.         MOVE.L  (A0)+,(A3)+
  1136.         MOVE.L  (A0)+,(A3)+
  1137.         ; Enlarge ( VAR addr: ADDRESS; len: LONGCARD; VAR ok: BOOLEAN );
  1138.         JMP     Enlarge
  1139.       trail
  1140.         CMPI.W  #$4EF2,D0
  1141.         BNE     ende
  1142.         MOVE.L  (A0)+,(A3)+
  1143.         MOVE.L  A0,-(A7)
  1144.         ; TrailAvail (ad: ADDRESS): LONGCARD;
  1145.         JSR     TrailAvail
  1146.         MOVE.L  (A7)+,A0
  1147.         MOVE.L  -(A3),(A0)
  1148.       ende
  1149.         TRAP    #6
  1150.         DC.W    IllegalCall
  1151.     END
  1152.   END More;
  1153.  
  1154.  
  1155. (*$L-*)
  1156. PROCEDURE terminate;
  1157.   BEGIN
  1158.     ASSEMBLER
  1159.         MOVE.L  ProcessID,A0
  1160.         MOVE.L  (A0),(A3)+
  1161.         JMP     DeAllocAll
  1162.     END
  1163.   END terminate;
  1164.  
  1165. (*$L-*)
  1166. PROCEDURE chgLevel ( doInc: BOOLEAN; child: BOOLEAN; VAR c: INTEGER );
  1167.   BEGIN
  1168.     ASSEMBLER
  1169.         SUBQ.L  #4,A3
  1170.         MOVE.L  -(A3),D0
  1171.         TST     D0
  1172.         BEQ     ende
  1173.         SWAP    D0
  1174.         TST     D0
  1175.         BNE     ende
  1176.         JMP     terminate
  1177.       ende
  1178.     END
  1179.   END chgLevel;
  1180.  
  1181.  
  1182. VAR ehdl: EnvlpCarrier;
  1183.     thdl: TermCarrier;
  1184.     wsp: MemArea;
  1185.     stack: ARRAY [1..200] OF WORD;
  1186.     v: CARDINAL; r: CARDINAL; d: Date;
  1187.     isTT: BOOLEAN;
  1188.  
  1189. BEGIN (* main *)
  1190.   ASSEMBLER
  1191.         SF      oldStorage
  1192.         (* diese Methode ist nicht so gut, um mxalloc()-Vorhandensein zu
  1193.            prfen. Besser: mxalloc aufrufen und prfen, ob neg. Returncode
  1194.            ("ill.opcode") geliefert wird.
  1195.         MOVE    #$30,-(A7)      ; Sversion
  1196.         TRAP    #1
  1197.         ADDQ.L  #2,A7
  1198.         CMPI.W  #$1900,D0
  1199.         SCC     D0
  1200.         ANDI    #1,D0
  1201.         MOVE.W  D0,gemdos1900
  1202.         *)
  1203.         
  1204.         ; Test auf Mxalloc:
  1205.         MOVE.W  #FALSE,hasMxalloc
  1206.         MOVE.W  #3,-(A7)        ; TT-RAM preferred
  1207.         MOVE.L  #-1,-(A7)       ; get free memory
  1208.         MOVE.W  #mx_alloc,-(A7)      ; Mxalloc-Opcode
  1209.         TRAP    #1
  1210.         ADDQ.L  #8,SP           ; Stack korrigieren
  1211.         CMPI.L  #-32,D0
  1212.         BEQ.S   noMxalloc
  1213.         MOVE.W  #TRUE,hasMxalloc
  1214. noMxalloc:
  1215.         (*
  1216.         PEA     g(PC)
  1217.         JSR     CallSuper
  1218.         ADDQ.L  #4,A7
  1219.         BRA     cont
  1220.       g MOVE.L  $4F2,A0           ; sysbase
  1221.         CMPI.B  #3,2(A0)
  1222.         SEQ     D0
  1223.         ANDI    #1,D0
  1224.         MOVE    D0,isTT
  1225.         RTS
  1226.         *)
  1227.       cont:
  1228.   END;
  1229.   MPBPtr := NIL;
  1230.   wsp.length:= SIZE (stack);
  1231.   CatchProcessTerm (thdl,terminate,wsp);
  1232.   SetEnvelope (ehdl,chgLevel,wsp)
  1233. END StorBase.
  1234.